home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / pibcat.arc / PIBCATK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-31  |  19.0 KB  |  421 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Display_ZIP_Contents --- Display contents of ZIP file        *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_ZIP_Contents( ZIPFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_ZIP_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a ZIP file                        *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_ZIP_Contents( ZIPFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          ZIPFileName --- name of ZIP file whose contents are to be   *)
  18. (*                          listed.                                     *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Get_Unix_Date     --- convert Unix date to string           *)
  25. (*          Open_File         --- open a file                           *)
  26. (*          Close_File        --- close a file                          *)
  27. (*          Entry_Matches     --- Perform wildcard match                *)
  28. (*          Display_Page_Titles                                         *)
  29. (*                            --- Display titles at top of page         *)
  30. (*          DUPL              --- Duplicate a character into a string   *)
  31. (*                                                                      *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. (*----------------------------------------------------------------------*)
  35. (*               Map of ZIP file entry headers                          *)
  36. (*----------------------------------------------------------------------*)
  37.  
  38. CONST
  39.    ZIP_Central_Header_Signature  = $02014B50;
  40.    ZIP_Local_Header_Signature    = $04034B50;
  41.    ZIP_End_Central_Dir_Signature = $06054B50;
  42.  
  43.    Central_Dir_Found             = 5;
  44.  
  45. TYPE
  46.                                    (* Structure of a local file header *)
  47.    ZIP_Local_Header_Type =
  48.       RECORD
  49.          Signature           : LONGINT  (* Header signature        *);
  50.          Version             : WORD     (* Vers. needed to extract *);
  51.          BitFlag             : WORD     (* General flags           *);
  52.          CompressionMethod   : WORD     (* Compression type used   *);
  53.          FileTime            : WORD     (* File creation time      *);
  54.          FileDate            : WORD     (* File creation date      *);
  55.          CRC32               : LONGINT  (* 32-bit CRC of file      *);
  56.          CompressedSize      : LONGINT  (* Compressed size of file *);
  57.          UnCompressedSize    : LONGINT  (* Original size of file   *);
  58.          FileNameLength      : WORD     (* Length of file name     *);
  59.          ExtraFieldLength    : WORD     (* Length of extra stuff   *);
  60.       END;
  61.  
  62.                                    (* Structure of the central *)
  63.                                    (* directory record         *)
  64.    ZIP_Central_Header_Type =
  65.       RECORD
  66.           Signature           : LONGINT (* Header signature        *);
  67.           VersionMadeBy       : WORD    (* System id/program vers. *);
  68.           VersionNeeded       : WORD    (* Vers. needed to extract *);
  69.           BitFlag             : WORD    (* General flags           *);
  70.           CompressionMethod   : WORD    (* Compression type used   *);
  71.           FileTime            : WORD    (* File creation time      *);
  72.           FileDate            : WORD    (* File creation date      *);
  73.           CRC32               : LONGINT (* 32-bit CRC of file      *);
  74.           CompressedSize      : LONGINT (* Compressed size of file *);
  75.           UnCompressedSize    : LONGINT (* Original size of file   *);
  76.           FileNameLength      : WORD    (* Length of file name     *);
  77.           ExtraFieldLength    : WORD    (* Length of extra stuff   *);
  78.           CommentFieldLength  : WORD    (* Length of comments      *);
  79.           DiskStartNumber     : WORD    (* Disk # file starts on   *);
  80.           InternalAttributes  : WORD    (* Text/non-text flags     *);
  81.           ExternalAttributes  : LONGINT (* File system attributes  *);
  82.           LocalHeaderOffset   : LONGINT (* Where local hdr starts  *);
  83.       END;
  84.  
  85. VAR
  86.    ZIPFile       : FILE         (* ZIP file to be read             *);
  87.  
  88.    ZIP_Entry     : ZIP_Central_Header_Type (* Central header       *);
  89.  
  90.    ZIP_Pos       : LONGINT      (* Current byte offset in ZIP file *);
  91.    Bytes_Read    : INTEGER      (* # bytes read from ZIP file file *);
  92.    Ierr          : INTEGER      (* Error flag                      *);
  93.    File_Name     : AnyStr       (* File name of entry in ZIP file  *);
  94.  
  95. (*----------------------------------------------------------------------*)
  96. (* Get_Next_ZIP_Local_Header --- Get next local header in ZIP file      *)
  97. (*----------------------------------------------------------------------*)
  98.  
  99. FUNCTION Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header :
  100.                                         ZIP_Local_Header_Type;
  101.                                     VAR Error : INTEGER  ) : BOOLEAN;
  102.  
  103. (*----------------------------------------------------------------------*)
  104. (*                                                                      *)
  105. (*    Function:  Get_Next_ZIP_Local_Header                              *)
  106. (*                                                                      *)
  107. (*    Purpose:   Gets next local header record in ZIP file              *)
  108. (*                                                                      *)
  109. (*    Calling sequence:                                                 *)
  110. (*                                                                      *)
  111. (*       OK := Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header:         *)
  112. (*                                            ZIP_Local_Header_Type;    *)
  113. (*                                        VAR Error : INTEGER ) :       *)
  114. (*                                        BOOLEAN;                      *)
  115. (*                                                                      *)
  116. (*          ZIP_Local_Header --- Local header data                      *)
  117. (*          Error            --- Error flag                             *)
  118. (*          OK               --- TRUE if header successfully found      *)
  119. (*                                                                      *)
  120. (*----------------------------------------------------------------------*)
  121.  
  122. BEGIN (* Get_Next_ZIP_Local_Header *)
  123.  
  124.                                    (* Assume no error to start       *)
  125.    Error := 0;
  126.                                    (* Position file                  *)
  127.    Seek( ZIPFile , ZIP_Pos );
  128.                                    (* Read in the file header entry. *)
  129.  
  130.    IF ( IOResult <> 0 ) THEN
  131.       Error := Format_Error
  132.  
  133.    ELSE
  134.       BEGIN
  135.  
  136.          BlockRead( ZIPFile, ZIP_Local_Header, SIZEOF( ZIP_Local_Header ),
  137.                     Bytes_Read );
  138.  
  139.                                    (* If wrong size read, or header marker *)
  140.                                    (* byte is incorrect, report ZIP file   *)
  141.                                    (* format error.                        *)
  142.  
  143.          IF ( ( IOResult <> 0 ) OR
  144.               ( Bytes_Read < SIZEOF( ZIP_Local_Header_Type ) ) ) THEN
  145.             Error := Format_Error
  146.          ELSE
  147.                                     (* Check for a legitimate header type  *)
  148.  
  149.             IF ( ZIP_Local_Header.Signature = ZIP_Local_Header_Signature ) THEN
  150.                BEGIN (* Local header -- skip it and associated data *)
  151.  
  152.                   ZIP_Pos := ZIP_Pos + ZIP_Local_Header.FileNameLength +
  153.                                        ZIP_Local_Header.ExtraFieldLength +
  154.                                        ZIP_Local_Header.CompressedSize +
  155.                                        SIZEOF( Zip_Local_Header_Type );
  156.                END
  157.  
  158.             ELSE IF ( ZIP_Local_Header.Signature = ZIP_Central_Header_Signature ) THEN
  159.                BEGIN (* Central header -- we want this *)
  160.  
  161.                   Error := Central_Dir_Found;
  162.  
  163.                END
  164.  
  165.             ELSE IF ( ZIP_Local_Header.Signature = ZIP_End_Central_Dir_Signature ) THEN
  166.                Error := End_Of_File;
  167.  
  168.       END;
  169.                                     (* Report success/failure to calling *)
  170.                                     (* routine.                          *)
  171.  
  172.    Get_Next_ZIP_Local_Header := ( Error = 0 );
  173.  
  174. END   (* Get_Next_ZIP_Local_Header *);
  175.  
  176. (*----------------------------------------------------------------------*)
  177. (*     Get_Next_ZIP_Entry --- Get next header entry in ZIP file         *)
  178. (*----------------------------------------------------------------------*)
  179.  
  180. FUNCTION Get_Next_ZIP_Entry( VAR ZIP_Entry : ZIP_Central_Header_Type;
  181.                              VAR FileName  : AnyStr;
  182.                              VAR Error     : INTEGER  ) : BOOLEAN;
  183.  
  184. (*----------------------------------------------------------------------*)
  185. (*                                                                      *)
  186. (*    Function:  Get_Next_ZIP_Entry                                     *)
  187. (*                                                                      *)
  188. (*    Purpose:   Gets header information for next file in ZIP file      *)
  189. (*                                                                      *)
  190. (*    Calling sequence:                                                 *)
  191. (*                                                                      *)
  192. (*       OK := Get_Next_ZIP_Entry( VAR ZIP_Entry :                      *)
  193. (*                                     ZIP_Central_Header_Type;         *)
  194. (*                                 VAR FileName  : AnyStr;              *)
  195. (*                                 VAR Error     : INTEGER ) : BOOLEAN; *)
  196. (*                                                                      *)
  197. (*          ZIP_Entry --- Header data for next file in ZIP file         *)
  198. (*          FileName  --- File name for this entry                      *)
  199. (*          Error     --- Error flag                                    *)
  200. (*          OK        --- TRUE if header successfully found, else FALSE *)
  201. (*                                                                      *)
  202. (*----------------------------------------------------------------------*)
  203.  
  204. VAR
  205.    L     : INTEGER;
  206.    L_Get : INTEGER;
  207.    L_Got : INTEGER;
  208.  
  209. BEGIN (* Get_Next_ZIP_Entry *)
  210.                                    (* Assume no error to start       *)
  211.    Error := 0;
  212.                                    (* Position file                  *)
  213.    Seek( ZIPFile , ZIP_Pos );
  214.                                    (* Read in the file header entry. *)
  215.  
  216.    IF ( IOResult <> 0 ) THEN
  217.       Error := Format_Error
  218.  
  219.    ELSE
  220.       BEGIN
  221.  
  222.          BlockRead( ZIPFile, ZIP_Entry, SIZEOF( ZIP_Central_Header_Type ),
  223.                     Bytes_Read );
  224.  
  225.                                    (* If wrong size read, or header marker *)
  226.                                    (* byte is incorrect, report ZIP file   *)
  227.                                    (* format error.                        *)
  228.  
  229.          IF ( IOResult <> 0 ) THEN
  230.             Error := Format_Error
  231.          ELSE IF ( Bytes_Read < SIZEOF( ZIP_Central_Header_Type ) ) THEN
  232.             BEGIN
  233.                                    (* Check for end of directory *)
  234.  
  235.                IF ( ZIP_Entry.Signature = ZIP_End_Central_Dir_Signature ) THEN
  236.                   Error := End_Of_File
  237.                ELSE
  238.                   Error := Format_Error;
  239.  
  240.             END
  241.          ELSE
  242.                                     (* Check for a legitimate header type  *)
  243.  
  244.             IF ( ZIP_Entry.Signature = ZIP_Central_Header_Signature ) THEN
  245.                BEGIN (* Central header -- we want this *)
  246.  
  247.                                    (* Pick up file name length.       *)
  248.                                    (* Only first 255 chars retrieved. *)
  249.  
  250.                   L := ZIP_Entry.FileNameLength;
  251.  
  252.                   IF ( L > 255 ) THEN
  253.                      L_Get := 255
  254.                   ELSE
  255.                      L_Get := L;
  256.  
  257.                                    (* Read file name characters. *)
  258.  
  259.                   BlockRead( ZIPFile, FileName[ 1 ], L_Get, L_Got );
  260.  
  261.                                    (* Check for I/O error *)
  262.  
  263.                   IF ( ( IOResult <> 0 ) OR ( L_Get<> L_Got ) ) THEN
  264.                      Error := Format_Error
  265.                   ELSE
  266.                      BEGIN
  267.                                    (* Position to next header *)
  268.  
  269.                         ZIP_Pos := ZIP_Pos + ZIP_Entry.ExtraFieldLength   +
  270.                                              ZIP_Entry.CommentFieldLength +
  271.                                              ZIP_Entry.FileNameLength     +
  272.                                              SIZEOF( Zip_Central_Header_Type );
  273.  
  274.                                    (* Set length of file name *)
  275.  
  276.                         FileName[ 0 ] := CHR( L_Got );
  277.  
  278.                      END;
  279.  
  280.                END
  281.                                    (* Check for end of directory *)
  282.  
  283.             ELSE IF ( ZIP_Entry.Signature = ZIP_End_Central_Dir_Signature ) THEN
  284.                Error := End_Of_File
  285.  
  286.                                    (* Anything else is bogus *)
  287.             ELSE
  288.                Error := Format_Error;
  289.  
  290.       END;
  291.  
  292.    Get_Next_ZIP_Entry := ( Error = 0 );
  293.  
  294. END   (* Get_Next_ZIP_Entry *);
  295.  
  296. (*----------------------------------------------------------------------*)
  297. (*   Find_ZIP_Central_Directory --- Find central ZIP file directory     *)
  298. (*----------------------------------------------------------------------*)
  299.  
  300. FUNCTION Find_ZIP_Central_Directory( VAR Error : INTEGER ) : BOOLEAN;
  301.  
  302. (*----------------------------------------------------------------------*)
  303. (*                                                                      *)
  304. (*    Function:  Find_ZIP_Central_Directory                             *)
  305. (*                                                                      *)
  306. (*    Purpose:   Finds central ZIP file directory                       *)
  307. (*                                                                      *)
  308. (*    Calling sequence:                                                 *)
  309. (*                                                                      *)
  310. (*       OK := Find_ZIP_Central_Directory( VAR Error : INTEGER ) :      *)
  311. (*                BOOLEAN;                                              *)
  312. (*                                                                      *)
  313. (*          Error    --- Error flag                                     *)
  314. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  315. (*                                                                      *)
  316. (*----------------------------------------------------------------------*)
  317.  
  318. VAR
  319.    ZIP_Local_Hdr : ZIP_Local_Header_Type   (* Local header         *);
  320.  
  321. BEGIN (* Find_ZIP_Central_Directory *)
  322.  
  323.                                    (* Assume no error to start          *)
  324.    Error   := 0;
  325.                                    (* Start at beginning of file.       *)
  326.    ZIP_Pos := 0;
  327.                                    (* Begin loop over local headers.    *)
  328.  
  329.                                    (* Report success/failure to calling *)
  330.                                    (* routine.                          *)
  331.  
  332.    WHILE ( Get_Next_ZIP_Local_Header( ZIP_Local_Hdr , Error ) ) DO;
  333.  
  334.    Find_ZIP_Central_Directory := ( Error = Central_Dir_Found );
  335.  
  336. END   (* Find_ZIP_Central_Directory *);
  337.  
  338. (*----------------------------------------------------------------------*)
  339. (*        Display_ZIP_Entry --- Display ZIP file file entry info        *)
  340. (*----------------------------------------------------------------------*)
  341.  
  342. PROCEDURE Display_ZIP_Entry( ZIP_Entry : ZIP_Central_Header_Type ;
  343.                              File_Name : AnyStr           );
  344.  
  345. VAR
  346.    FName     : AnyStr;
  347.    TimeDate  : LONGINT;
  348.    TimeDateW : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  349.    DirS      : DirStr;
  350.    FExt      : ExtStr;
  351.  
  352. BEGIN (* Display_ZIP_Entry *)
  353.  
  354.    WITH ZIP_Entry DO
  355.       BEGIN
  356.                                    (* Pick up short file name. *)
  357.  
  358.          FSplit( File_Name, DirS, FName, FExt );
  359.  
  360.          FName := FName + FExt;
  361.  
  362.                                    (* See if this file matches the   *)
  363.                                    (* entry spec wildcard.  Exit if  *)
  364.                                    (* not.                           *)
  365.          IF Use_Entry_Spec THEN
  366.             IF ( NOT Entry_Matches( FName ) ) THEN
  367.                EXIT;
  368.                                    (* Get date and time of creation *)
  369.  
  370.          TimeDateW[ 1 ] := FileTime;
  371.          TimeDateW[ 2 ] := FileDate;
  372.  
  373.                                    (* Display long file name if requested *)
  374.                                    (* and if not the same as the short    *)
  375.                                    (* name.                               *)
  376.  
  377.          IF Show_Long_File_Names THEN
  378.             IF ( FName = File_Name ) THEN
  379.                File_Name := '';
  380.  
  381.                                    (* Display this entry's information *)
  382.  
  383.          Display_One_Entry( FName, UnCompressedSize, TimeDate, ZIPFileName,
  384.                             Current_Subdirectory, File_Name );
  385.  
  386.       END;
  387.  
  388. END (* Display_ZIP_Entry *);
  389.  
  390. (*----------------------------------------------------------------------*)
  391.  
  392. BEGIN (* Display_ZIP_Contents *)
  393.                                    (* Open ZIP file and initialize *)
  394.                                    (* contents display.            *)
  395.  
  396.    IF Start_Contents_Listing( ' ZIP file: ',
  397.                               Current_Subdirectory + ZIPFileName, ZIPFile,
  398.                               ZIP_Pos, Ierr ) THEN
  399.       BEGIN
  400.                                    (* Skip to central directory in ZIP file *)
  401.  
  402.          IF Find_ZIP_Central_Directory( Ierr ) THEN
  403.  
  404.                                    (* Loop over entries      *)
  405.  
  406.             WHILE ( Get_Next_ZIP_Entry( ZIP_Entry , File_Name , Ierr ) ) DO
  407.                Display_ZIP_Entry( ZIP_Entry , File_Name )
  408.  
  409.          ELSE
  410.             BEGIN
  411.                Display_Error( 'Failed to find central ZIP directory' );
  412.                Ierr := End_Of_File;
  413.             END;
  414.                                    (* Close ZIP file file *)
  415.  
  416.          End_Contents_Listing( ZIPFile , Ierr );
  417.  
  418.       END;
  419.  
  420. END   (* Display_ZIP_Contents *);
  421.